
 1000  *SAVE S.DP18 INPUT
 1010  *-------------------------------
 1020  *    APPLESOFT SUBROUTINES
 1030  *-------------------------------
 1040  AS.INLIN     .EQ $D52E   READ A LINE
 1050  AS.PARSE     .EQ $D559   PARSE INPUT BUFFER
 1060  AS.BREAK     .EQ $D863   CTRL-C BREAK
 1070  AS.ADDON     .EQ $D998   ADD (Y) TO TXTPTR
 1080  AS.COUT      .EQ $DB5C    PRINT A CHARACTER
 1090  AS.CHKCOM    .EQ $DEBE    CHECK FOR COMMA
 1100  AS.SYNERR    .EQ $DEC9    SYNTAX ERROR
 1110  AS.GETSPA    .EQ $E452
 1120  AS.MOVSTR    .EQ $E5E2
 1130  *--------------------------------
 1140  *   MONITOR SUBROUTINES
 1150  *--------------------------------
 1160  MON.RDKEY    .EQ $FD0C
 1170  MON.LF       .EQ $FC66
 1180  *--------------------------------
 1190  *      DP SUBROUTINES PRINTED ELSEWHERE
 1200  *--------------------------------
 1210  DP.NEXT.CMD         .EQ $FFFF
 1220  DP.EVALUATE         .EQ $FFFF
 1230  MOVE.DAC.YA         .EQ $FFFF
 1240  DP.VTAB             .EQ $FFFF
 1250  DP.INT              .EQ $FFFF
 1260  DP.FALSE            .EQ $FFFF
 1270  MOVE.DAC.TEMP1      .EQ $FFFF
 1280  MOVE.TEMP1.DAC      .EQ $FFFF
 1290  PRINT.INPUT         .EQ $FFFF
 1300  FIN                 .EQ $FFFF
 1310  GET.A.VAR           .EQ $FFFF
 1320  CHECK.DP.VAR        .EQ $FFFF
 1330  MOVE.YA.DAC         .EQ $FFFF
 1340  PRUS.CLEAR          .EQ $FFFF
 1350  PRUS.NEXT           .EQ $FFFF
 1360  ACCUMULATE.DIGIT    .EQ $FFFF
 1370  PRT.NUM.1           .EQ $FFFF
 1380  PRINT.STR.1         .EQ $FFFF
 1390  *-------------------------------
 1400  *      PAGE ZERO USAGE
 1410  *-------------------------------
 1420  AS.VALTYP    .EQ $11
 1430  MON.WNDWIDTH .EQ $21
 1440  MON.CH       .EQ $24
 1450  MON.CV       .EQ $25
 1460  AS.FRESPA    .EQ $71,72
 1470  AS.CHRGET    .EQ $B1
 1480  AS.CHRGOT    .EQ $B7
 1490  TXTPTR       .EQ $B8,B9
 1500  P2           .EQ $F9
 1510  P1           .EQ $FD      GP POINTER
 1520  *--------------------------------
 1530  WBUF         .EQ $0200
 1540  *-------------------------------
 1550  *      WORK AREAS FOR DPFP
 1560  *-------------------------------
 1570  DECFLG              .BS 1
 1580  DAC.EXPONENT        .BS 1
 1590  DAC.SIGN            .BS 1
 1600  IBUF                .BS 256
 1610  STACK.PNTR          .BS 1
 1620  STACK               .BS 12*10
 1630  W                   .BS 1
 1640  D                   .BS 1
 1650  OLD.W               .BS 1
 1660  OLD.D               .BS 1
 1670  DGTCNT              .BS 1
 1680  INPUT.TYPE          .BS 1
 1690  FOUND.NUM           .BS 1
 1700  FOUND.STR           .BS 1
 1710  FOUND.LEN           .BS 1
 1720  FOUND.CHAR          .BS 1
 1730  FILL.CHAR           .BS 1
 1740  ZERO.CHAR           .BS 1
 1750  FLD.FLAG            .BS 1
 1760  FLD.START           .BS 1
 1770  TEMP                .BS 2
 1780  RESULT              .BS 2
 1790  DEFAULT.FLAG        .BS 1
 1800  LEN                 .BS 1
 1810  *--------------------------------
 1820  DP.SYN3 JMP AS.SYNERR
 1830  *--------------------------------
 1840  DP.INPUT
 1850         JSR AS.CHRGET
 1860         BEQ DP.SYN3  ...COLON OR EOL
 1870  *---INPUT USING------------------
 1880         CMP #'$'     INPUT USING PICTURE?
 1890         BNE .1       ...NO
 1900         LDA #0       ...YES, SIGNAL "INPUT" AND JOIN
 1910         JMP PRINT.INPUT       "PRINT $"
 1920  *---INPUT AN EXPRESSION----------
 1930  .1     STA INPUT.TYPE    ="#" IF EXP, ELSE <>"#"
 1940         CMP #'#'          INPUT AN EXPRESSION?
 1950         BNE .2            ...NO
 1960         JSR AS.CHRGET     ...YES, GET NEXT CHAR
 1970  .2     LDX #"?"     PROMPT CHAR FOR NO QUOTE
 1980         CMP #'"'     QUOTE?
 1990         BNE .6       ...NO, SIMPLE INPUT
 2000         LDY #0       ...YES, PRINT IT NOW
 2010  .3     INY
 2020         LDA (TXTPTR),Y    NEXT QUOTED CHARACTER
 2030         BEQ DP.SYN3       ...NO CLOSING QUOTE
 2040         CMP #'"'          CLOSING QUOTE YET?
 2050         BEQ .4            ...YES
 2060         JSR AS.COUT       ...NO, PRINT CHARACTER
 2070         BNE .3            ...ALWAYS
 2080  .4     JSR AS.ADDON      ADD (Y) TO TXTPTR
 2090  .5     JSR AS.CHRGET     SCAN NEXT CHAR
 2100         CMP #';'          ALLOW OPTIONAL SEMICOLON
 2110         BEQ .5            ...KEEP LOOKING TILL NOT ';'
 2120         LDX #$80          NULL PROMPT CHARACTER
 2130  *---READ A LINE OF TEXT----------
 2140  .6     JSR AS.INLIN      '?' OR NULL PROMPT
 2150         LDA WBUF          CHECK FOR EMPTY LINE
 2160         BEQ .11           ...EMPTY LINE
 2170         CMP #$03          CTRL-C?
 2180         BNE .7            ...NO
 2190         JMP AS.BREAK      ABORT INPUT
 2200  *---PARSE THE INPUT LINE---------
 2210  .7     LDA TXTPTR        SAVE TXTPTR, WHICH POINTS
 2220         PHA               AT THE PROGRAM
 2230         LDA TXTPTR+1
 2240         PHA
 2250         STX TXTPTR        MAKE TXTPTR POINT AT INPUT BUFFER
 2260         STY TXTPTR+1
 2270         JSR AS.CHRGET     GET FIRST CHAR FROM LINE
 2280         LDY INPUT.TYPE    SEE IF SIMPLE OR EXPRESSIONS
 2290         CPY #'#'
 2300         BNE .8            SIMPLE NUMERIC INPUT
 2310         JSR AS.PARSE      EXPRESSION INPUT, SO PARSE
 2320         LDA #WBUF-1       POINT AT INPUT BUFFER AGAIN
 2330         STA TXTPTR        SO EVALUATE CAN PROCESS THE
 2340         LDA /WBUF-1       PARSED LINE
 2350         STA TXTPTR+1
 2360         JSR AS.CHRGET     SCAN FIRST CHAR
 2370         JSR DP.EVALUATE   EVALUATE THE EXPRESSION
 2380         JMP .9
 2390  .8     JSR FIN           SIMPLE NUMERIC INPUT
 2400  .9     PLA               RESTORE TXTPTR TO PROGRAM
 2410         STA TXTPTR+1
 2420         PLA
 2430         STA TXTPTR
 2440  .10    JSR AS.CHRGOT     GET CURRENT PROGRAM CHAR
 2450         JSR GET.A.VAR     GET INPUT VARIABLE
 2460         JSR CHECK.DP.VAR  MUST BE DP18 VARIABLE
 2470         JSR MOVE.DAC.YA   STORE INPUT VALUE
 2480         JMP DP.NEXT.CMD   ...FINISHED?
 2490  *---EMPTY INPUT LINE-------------
 2500  .11    JSR DP.FALSE      RETURN VALUE = 0
 2510         JMP .10
 2520  *--------------------------------
 2530  INPUT.NUM
 2540         LDA #0       TERMINATE STRING IN BUFFERS
 2550         STA IBUF,X
 2560         STA WBUF,X
 2570  .1     LDA WBUF-1,X      COPY STRING TO IBUF
 2580         STA IBUF-1,X
 2590         DEX
 2600         BNE .1
 2610         LDA FILL.CHAR
 2620         STA TEMP
 2630         JSR STACK.IT
 2640         JSR AS.CHKCOM     MUST HAVE COMMA
 2650         JSR GET.A.VAR
 2660         JSR CHECK.DP.VAR
 2670         STA RESULT   SAVE ADR OF VARIABLE
 2680         STY RESULT+1
 2690         JSR MOVE.YA.DAC  MOVE DEFAULT INTO DAC
 2700         LDA W
 2710         STA OLD.W
 2720         LDA #1
 2730         STA DEFAULT.FLAG
 2740         LDA DAC.EXPONENT  IS DAC 0?
 2750         BNE INP.X1   NO
 2760  INP.X  JSR INP.ZERO.DAC DEFAULT IS 0 OR CTRL-X
 2770  INP.X1 LDA #0
 2780         STA FLD.FLAG
 2790         STA DGTCNT
 2800         STA DECFLG
 2810         LDA D
 2820         STA OLD.D
 2830         LDA #$5F     UNDERLINE
 2840         STA FILL.CHAR
 2850  INP.NEXT.ZERO.CHAR
 2860         STA ZERO.CHAR
 2870  *--------------------------------
 2880  INP.NEXT
 2890         JSR INP.PRINT.NUM PRINT THE NUMBER
 2900         JSR MOVE.TEMP1.DAC
 2910         JSR MON.RDKEY
 2920         AND #$7F
 2930         CMP #$0D     RETURN?
 2940         BEQ .2       ...YES
 2950         LDX DEFAULT.FLAG
 2960         BEQ .1       NO DEFAULT
 2970         JSR INP.ZERO.DAC IGNORE DEFAULT
 2980         CMP #8       BACKSPACE?
 2990         BEQ INP.NEXT YES,IGNORE
 3000  *---DIGIT------------------------
 3010  .1     CMP #'0      SEE IF NUMBER
 3020         BCC .4       NO
 3030         CMP #'9+1
 3040         BCS .4       NO
 3050         JSR ACCUMULATE.DIGIT
 3060         JMP INP.NEXT
 3070  *---CARRIAGE RETURN--------------
 3080  .2     LDA DGTCNT   IS NUMBER 0?
 3090         ORA DEFAULT.FLAG
 3100         BNE .3       NO
 3110         STA DAC.EXPONENT YES,SO ZERO THE EXPONENT
 3120  .3     LDA RESULT   GET ADR OF VAR
 3130         LDY RESULT+1
 3140         JSR MOVE.DAC.YA  PUT IT IN VAR
 3150         LDA TEMP     RESTORE ORIGINAL FILL CHAR
 3160         STA FILL.CHAR
 3170         LDA #'0
 3180         STA ZERO.CHAR
 3190         JMP INP.PRINT.NUM PRINT THE NUMBER
 3200  *                        AND RETURN
 3210  *---DECIMAL POINT----------------
 3220  .4     CMP #'.      DEC POINT?
 3230         BNE .5       ...NO
 3240  *      SEC          'CMP' LEFT CARRY SET
 3250         ROR DECFLG   FOUND DEC PT
 3260         BIT DECFLG
 3270         BVS INP.NEXT       TWO DEC PTS.
 3280         LDA #$40
 3290         CLC
 3300         ADC DGTCNT
 3310         STA DAC.EXPONENT
 3320         LDA #'0
 3330         BEQ INP.NEXT.ZERO.CHAR  ALWAYS
 3340  *---MINUS SIGN-------------------
 3350  .5     CMP #'-      MINUS?
 3360         BNE .6
 3370  *      SEC          'CMP' LEFT CARRY SET
 3380         ROR DAC.SIGN MAKE DAC NEGATIVE
 3390         BNE INP.NEXT ...ALWAYS
 3400  *---PLUS SIGN--------------------
 3410  .6     CMP #'+      PLUS?
 3420         BNE .7       ...NO
 3430         STA DAC.SIGN PUT POSITIVE VALUE IN SIGN
 3440         BEQ INP.NEXT ...ALWAYS
 3450  *---CTRL-X-----------------------
 3460  .7     CMP #$18     CTRL-X?
 3470         BNE .8
 3480         LDA OLD.D
 3490         STA D
 3500         JMP INP.X
 3510  *---CTRL-C-----------------------
 3520  .8     CMP #$3      CTRL-C?
 3530         BNE .9       ...NO, TRY BACKSPACE
 3540         JMP AS.BREAK
 3550  *---BACKSPACE--------------------
 3560  .9     CMP #$08     BACKSPACE?
 3570         BNE .17      ...NO, TAKE PATH TO INP.NEXT 
 3580         LDA DECFLG
 3590         BPL .10
 3600         LDA DAC.EXPONENT
 3610         SEC
 3620         SBC #$40
 3630         CMP DGTCNT
 3640         BEQ .15      REMOVE DEC PT ONLY
 3650  *--------------------------------
 3660  .10    LDA DAC.EXPONENT
 3670         PHA          SAVE EXPONENT
 3680         LDA DGTCNT
 3690         CLC
 3700         ADC #$3F
 3710         STA DAC.EXPONENT
 3720         JSR DP.INT   CHOP OFF LAST DIGIT
 3730         LDA DAC.EXPONENT
 3740         BEQ .14      THE NUMBER IS 0, SO RESET EVERYTHING
 3750  .11    PLA
 3760         STA DAC.EXPONENT
 3770         LDA DGTCNT
 3780         BNE .12
 3790         JSR LAST.FLD
 3800         JMP INP.NEXT
 3810  .12    DEC DGTCNT
 3820         BNE .13
 3830         DEC DAC.EXPONENT
 3840  .13    LDA DECFLG
 3850         BPL .16      DELETE BY SHIFT
 3860         BMI .17      ALWAYS
 3870  *--------------------------------
 3880  .14    LDA DECFLG
 3890         BPL .11
 3900         PLA
 3910  .15    LDA #$3F
 3920         SEC
 3930         SBC OLD.D
 3940         ADC DGTCNT
 3950         STA DAC.EXPONENT
 3960         LDA #0
 3970         STA DECFLG
 3980         LDA #$5F
 3990         JMP INP.NEXT.ZERO.CHAR
 4000  *--------------------------------
 4010  .16    LDA DGTCNT
 4020         BEQ .17
 4030         DEC DAC.EXPONENT
 4040  .17    JMP INP.NEXT
 4050  *--------------------------------
 4060  INP.PRINT.NUM
 4070         LDX #-1      COPY IBUF TO WBUF
 4080  .1     INX
 4090         LDA IBUF,X
 4100         STA WBUF,X
 4110         BNE .1
 4120         JSR RESTORE.HV.FROM.STACK
 4130         LDA OLD.W
 4140         STA W
 4150         LDA OLD.D
 4160         STA D
 4170         JSR MOVE.DAC.TEMP1
 4180         LDA DECFLG
 4190         PHA
 4200         JSR PRT.NUM.1
 4210         PLA
 4220         STA DECFLG
 4230         RTS
 4240  *--------------------------------
 4250  INP.ZERO.DAC
 4260         PHA
 4270         JSR DP.FALSE PUT 0 IN DAC
 4280         LDA #$40
 4290         SEC
 4300         SBC D        CALCULATE EXPONENT
 4310         STA DAC.EXPONENT
 4320         LDA #0
 4330         STA DEFAULT.FLAG
 4340         PLA
 4350         RTS
 4360  *--------------------------------
 4370  LAST.FLD
 4380         LDY STACK.PNTR
 4390         DEY
 4400         DEY
 4410         DEY
 4420         DEY
 4430         DEY
 4440         BNE .1
 4450         RTS          FIRST FIELD
 4460  .1     PLA          DISCARD JSR LAST.FLD
 4470         PLA               "
 4480         PLA          DISCARD JSR INPUT.NUM
 4490         PLA               "
 4500         PLA          DISCARD Y-REG
 4510         PLA          DISCARD JSR PRT.NUM.IF.NEEDED
 4520         PLA               "
 4530         PLA          DISCARD JSR LOOKUP
 4540         PLA               "
 4550         DEY
 4560         LDA STACK,Y
 4570         STA TXTPTR+1
 4580         DEY
 4590         LDA STACK,Y
 4600         STA TXTPTR
 4610         DEY
 4620         LDA STACK,Y
 4630         PHA          SAVE INDEX INTO PICTURE
 4640         DEY
 4650         LDA STACK,Y
 4660         JSR DP.VTAB
 4670         DEY
 4680         LDA STACK,Y
 4690         STA MON.CH
 4700         STY STACK.PNTR
 4710         PLA          RESTORE INDEX INTO PICTURE
 4720         TAY
 4730         JSR PRUS.CLEAR
 4740         JMP PRUS.NEXT
 4750  *--------------------------------
 4760  STACK.IT
 4770         LDY STACK.PNTR
 4780         LDA MON.CH   SAVE WHERE THE FIELD IS
 4790         STA STACK,Y
 4800         INY
 4810         LDA MON.CV
 4820         STA STACK,Y
 4830         INY
 4840         DEC FLD.START
 4850         LDA FLD.START
 4860         STA STACK,Y
 4870         INY
 4880         LDA TXTPTR
 4890         STA STACK,Y  SAVE TXTPTR
 4900         INY
 4910         LDA TXTPTR+1
 4920         STA STACK,Y
 4930         INY
 4940         STY STACK.PNTR
 4950         RTS
 4960  *--------------------------------
 4970  INPUT.STR
 4980         JSR STACK.IT
 4990         JSR AS.CHKCOM   MUST HAVE COMMA
 5000         JSR GET.A.VAR   GET ADR OF VAR
 5010         LDX AS.VALTYP   STR OR NUM
 5020         BMI .1       OK
 5030         JMP AS.SYNERR   MUST BE STRING
 5040  .1     STA P1
 5050         STY P1+1
 5060         LDY #0       GET STRING
 5070         STY DEFAULT.FLAG
 5080         STY FLD.FLAG
 5090         STY LEN
 5100         LDA (P1),Y   LENGTH
 5110         BEQ .3       NULL STRING, SO DO NOTHING
 5120         STA LEN
 5130         INY
 5140         LDA (P1),Y   ADR OF STRING
 5150         STA P2       LO ADR
 5160         INY
 5170         LDA (P1),Y
 5180         STA P2+1     HI ADR
 5190         LDY LEN      GET LENGTH
 5200         DEY
 5210  .2     LDA (P2),Y
 5220         STA WBUF,Y
 5230         DEY
 5240         BNE .2
 5250         LDA (P2),Y   MOVE LAST BYTE
 5260         STA WBUF
 5270         INY          Y = 1
 5280         STA DEFAULT.FLAG  YES THERE IS A DEFAULT
 5290  .3     LDA #WBUF
 5300         STA P2
 5310         LDA /WBUF
 5320         STA P2+1
 5330         BNE IS.X1    ALWAYS
 5340  *--------------------------------
 5350  IS.X   LDA #0
 5360         STA LEN
 5370  IS.X1  LDA FOUND.LEN
 5380         PHA
 5390         LDA FOUND.CHAR
 5400         PHA
 5410         JSR RESTORE.HV.FROM.STACK
 5420         LDA #$5F     UNDERLINE
 5430         STA FILL.CHAR
 5440         LDA LEN
 5450         JSR PRINT.STR.1
 5460         PLA
 5470         STA FOUND.CHAR
 5480         PLA
 5490         STA FOUND.LEN
 5500         CMP LEN
 5510         BCC .3       OVERFLOW
 5520  *---FIND END OF STRING & PUT CURSOR THERE---
 5530         JSR RESTORE.HV.FROM.STACK
 5540         CLC
 5550         ADC LEN      ADD LENGTH OF STRING
 5560  .1     CMP MON.WNDWIDTH LONGER THAN WINDOW?
 5570         BCC .2
 5580         SBC MON.WNDWIDTH WRAP AROUND
 5590         PHA
 5600         JSR MON.LF   JUMP DOWN TO NEXT LINE
 5610         PLA
 5620         JMP .1
 5630  .2     STA MON.CH   PUT COLUMN BACK IN CH
 5640  *---INPUT A CHAR NOW-------------
 5650  .3     JSR MON.RDKEY
 5660         AND #$7F
 5670  *---CARRIAGE RETURN--------------
 5680         CMP #$0D     RETURN?
 5690         BNE .5       ...NO
 5700         LDA DEFAULT.FLAG
 5710         BNE .4       DEFAULT, SO LEAVE IT ALONE
 5720         LDA LEN      GET LENGTH
 5730         JSR AS.GETSPA MAKE ROOM FOR STRING
 5740         LDY #0       MOVE DATA INTO VARIABLE
 5750         STA (P1),Y   LENGTH
 5760         LDA AS.FRESPA
 5770         INY
 5780         STA (P1),Y   LO ADDRESS
 5790         LDA AS.FRESPA+1
 5800         INY
 5810         STA (P1),Y   HI ADDRESS
 5820         LDX #WBUF
 5830         LDY /WBUF
 5840         LDA LEN
 5850         JSR AS.MOVSTR
 5860  .4     JSR RESTORE.HV.FROM.STACK
 5870         LDA #$20     SPACE
 5880         STA FILL.CHAR
 5890         LDA LEN
 5900         JMP PRINT.STR.1   PRINT IT ONE MORE TIME
 5910  *--------------------------------
 5920  .5     LDX DEFAULT.FLAG
 5930         BEQ .6       ...NO DEFAULT
 5940         LDX #0
 5950         STX DEFAULT.FLAG GET RID OF DEFAULT
 5960         STX LEN      NULL STRING
 5970         CMP #8       BACKSPACE AND DEFAULT?
 5980         BNE .8
 5990         JMP IS.X1
 6000  *---BACKSPACE--------------------
 6010  .6     CMP #8       BACKSPACE?
 6020         BNE .8
 6030         LDA LEN
 6040         BNE .7
 6050         JSR LAST.FLD BACKUP A FIELD
 6060         JMP IS.X1
 6070  .7     DEC LEN
 6080         JMP IS.X1
 6090  *---CTRL-X-----------------------
 6100  .8     CMP #$18     CTRL-X?
 6110         BNE .9
 6120         JMP IS.X
 6130  *---CTRL-C-----------------------
 6140  .9     CMP #3       CTRL-C?
 6150         BNE .10      ...NO
 6160         JMP AS.BREAK
 6170  *---CHAR FOR STRING--------------
 6180  .10    LDY LEN      NORMAL CHAR,
 6190         STA WBUF,Y   SAVE IT
 6200         INC LEN
 6210         JMP IS.X1
 6220  *--------------------------------
 6230  RESTORE.HV.FROM.STACK
 6240         LDY STACK.PNTR
 6250         LDA STACK-4,Y
 6260         JSR DP.VTAB
 6270         LDA STACK-5,Y
 6280         STA MON.CH
 6290         RTS
 6300  *--------------------------------

